home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 008 / synthibm.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-04-24  |  6.5 KB  |  221 lines
  1. 100  DEFINT A-Z:ON ERROR GOTO 120
  2. 110  GOTO 140
  3. 120  'error handler
  4. 130  RESUME NEXT
  5. 140  OPTION BASE 1:DIM ROW(25)
  6. 150  FOR I=1 TO 25:READ ROW(I):NEXT I
  7. 160  DATA 6,25,20,2,15,24,1,13,7,9,5,18,3,14,19,4,8,11,23,12,22,10,16,17,21
  8. 170  WIDTH 40:KEY OFF:CLS:LOCATE ,,0
  9. 180  COLOR 7,0,1
  10. 190  FOR I = 1 TO 96
  11. 200   A = INT(RND*2400 + 1000)
  12. 210  PRINT STRING$(10,CHR$(14));
  13. 220  SOUND A,0.01
  14. 230  SOUND 100 + I,0.01
  15. 240  NEXT I
  16. 250  PLAY "l16o4go5cege2g"
  17. 260  COLOR 15,0:LOCATE 13,13:PRINT" version  -0.01 ";
  18. 270  COLOR 0,15:LOCATE 9,8:PRINT" The AMAZING,INCREDULOUS ";
  19. 280  COLOR 15,0:LOCATE 11,11:PRINT" SYNSONIC ORGANITRON ";
  20. 290  COLOR 31,0:LOCATE 20,5:PRINT" WARNING:";:COLOR 0,15:PRINT" please do not copy this program it took me and my brother ALL DAY to write !
  21. 300  COLOR 15,3 :LOCATE 25,1:PRINT"       press any key to continue        ";
  22. 310  K$=INKEY$:IF K$ = "" THEN 310
  23. 320  COLOR 7,0,4
  24. 330  LOCATE 25,1:PRINT STRING$(79," "):LOCATE 25,1
  25. 340  FOR I = 1 TO 499
  26. 350  COLOR 15,0:PRINT STRING$(1,CHR$(17));:SOUND 19000,0.01:
  27. 360  COLOR 0,15:PRINT STRING$(1,CHR$(16));:SOUND 8200,0.01
  28. 370  NEXT I
  29. 380  COLOR 15,0:PRINT CHR$(17);
  30. 390  COLOR 15,0,0
  31. 400  PLAY "MNl4o1t255c2c8p8cd2"
  32. 410  LOCATE 4,3,0:PRINT "Conceived...";
  33. 420  PLAY "d8p8g2g8p8f8p8e8p8d8p8c2":LOCATE 4,21:PRINT "Composed...";
  34. 430  PLAY "c2c8p8cd2d8p8f2f8p8e-8p8d8p8c8p8o0b-2":LOCATE 6,11:PRINT "Contrived...";
  35. 440  PLAY "b-2b-b-o1c2d2ddd+2":LOCATE 7,25:PRINT "Devised...";
  36. 450  PLAY "d+o0b-2b-b-o1c2"
  37. 460  LOCATE 9,3:PRINT "and forged ";
  38. 470  PLAY "MBcg2gedcg2g2d+dcggccgg2ecgg2e-c1o0c1"
  39. 480  PRINT "from the cerebrations ";
  40. 490  LOCATE 11,2:PRINT "of the cosmic cognizant conciousnesses ";
  41. 500  LOCATE 13,20:PRINT "of..."
  42. 510  LOCATE 15,6:PRINT "Joseph Edward ";:COLOR 31,0:PRINT "`The Chimp'";:COLOR 15,0:PRINT" Batutis";
  43. 520  LOCATE 17,20:PRINT "and";
  44. 530  LOCATE 19,6:PRINT "Edward Joseph ";:COLOR 31,0:PRINT "`Eddie Baby'";:COLOR 15,0:PRINT" Batutis";
  45. 540  LOCATE 24,1:COLOR 15,0:PRINT "     press any key to continue         ";
  46. 550  FOR I=1 TO 2000:I=I:NEXT I
  47. 560  K$=INKEY$:IF K$="" THEN 560
  48. 570  FOR M=1 TO 20
  49. 580  FOR J=1 TO 25
  50. 590  LOCATE ROW(J),M+20:PRINT " ";
  51. 600  NEXT J
  52. 610  FOR L=1 TO 25
  53. 620  LOCATE ROW(L),21-M:PRINT " ";
  54. 630  NEXT L,M
  55. 640  CLS
  56. 650  CLS:SCREEN 1:IF FLAG<>0 THEN 680  ELSE FLAG=1
  57. 660  DIM BH1(500),BH2(500),TH1(500),TH2(500),RV1(500),RV2(500),LV1(500),LV2(500)
  58. 670  ON ERROR GOTO 120
  59. 680  COLOR 0,3
  60. 690  FOR A=14 TO 302 STEP 12
  61. 700  CIRCLE (A,4),4
  62. 710  NEXT A
  63. 720  FOR A=8 TO 196 STEP 9
  64. 730  CIRCLE (314,A),4
  65. 740  NEXT A
  66. 750  FOR A=314 TO 14 STEP -12
  67. 760  CIRCLE (A,196),4
  68. 770  NEXT A
  69. 780  FOR A=191 TO 8 STEP -9
  70. 790  CIRCLE (8,A),4
  71. 800  NEXT A
  72. 810  CIRCLE (14,4),4
  73. 820  COLOR 0,7
  74. 830  FOR A=26 TO 302 STEP 24
  75. 840  PAINT (A,4),2,3
  76. 850  NEXT A
  77. 860  GET (1,1)-(319,10),TH1
  78. 870  FOR A=26 TO 302 STEP 24
  79. 880  PAINT (A,4),0,3
  80. 890  NEXT A
  81. 900  FOR A=14 TO 302 STEP 24
  82. 910  PAINT (A,4),2,3
  83. 920  NEXT A:GET (1,1)-(319,10),TH2
  84. 930  FOR A=8 TO 196 STEP 18
  85. 940  PAINT (314,A),2,3
  86. 950  NEXT A
  87. 960  GET(310,1)-(319,199),RV1
  88. 970  FOR A=8 TO 196 STEP 18
  89. 980  PAINT (314,A),0,3
  90. 990  NEXT A
  91. 1000  FOR A=17 TO 196 STEP 18
  92. 1010  PAINT (314,A),2,3
  93. 1020  NEXT A
  94. 1030  GET(310,1)-(319,199),RV2
  95. 1040  FOR A=314 TO 14 STEP -24
  96. 1050  PAINT (A,196),2,3
  97. 1060  NEXT A
  98. 1070  GET (1,190)-(319,199),BH1
  99. 1080  FOR A=314 TO 14 STEP -24
  100. 1090  PAINT (A,196),0,3
  101. 1100  NEXT A
  102. 1110  FOR A=302 TO 14 STEP -24
  103. 1120  PAINT (A,196),2,3
  104. 1130  NEXT A
  105. 1140  GET (1,190)-(319,199),BH2
  106. 1150  FOR A=183 TO 8 STEP -18
  107. 1160  PAINT (8,A),2,3
  108. 1170  NEXT A
  109. 1180  GET (1,1)-(12,199),LV1
  110. 1190  FOR A=183 TO 8 STEP -18
  111. 1200  PAINT (8,A),0,3
  112. 1210  NEXT A
  113. 1220  FOR A=191 TO 8 STEP -18
  114. 1230  PAINT (8,A),2,3
  115. 1240  NEXT A
  116. 1250  GET (1,1)-(12,199),LV2
  117. 1260  LOCATE 7,20:PRINT " MENU ";
  118. 1270  LOCATE 10,17:PRINT "a-ORGANITEK"
  119. 1280  LOCATE 12,17:PRINT "b-ORGANISCOPE"
  120. 1290  LOCATE 14,17:PRINT "c-BLUEZORG"
  121. 1300  LOCATE 16,17:PRINT "d-SPACEORG"
  122. 1310  LOCATE 18,17,0:PRINT "q-QUIT"
  123. 1320  LOCATE 20,5:PRINT "(First choose letter, then hit":LOCATE 21,7:PRINT "lowercase keys for tones)"
  124. 1330  PLAY "mbl4T190MSO4p1ge8p8ap8g8fd8p8gp8f8e8p8cf8p8dgp8g8c2"
  125. 1340  A$ = INKEY$:IF A$<> "" THEN 1440
  126. 1350  PUT (1,1),TH1,XOR:PUT(1,1),TH2
  127. 1360  PUT (310,1),RV1,XOR:PUT(310,1),RV2
  128. 1370  PUT (1,190),BH1,XOR:PUT(1,190),BH2
  129. 1380  PUT (1,1),LV1,XOR:PUT(1,1),LV2
  130. 1390  PUT(1,1),TH2,XOR:PUT(1,1),TH1
  131. 1400  PUT(310,1),RV2,XOR:PUT(310,1),RV1
  132. 1410  PUT(1,190),BH2,XOR:PUT(1,190),BH1
  133. 1420  PUT(1,1),LV2,XOR:PUT(1,1),LV1
  134. 1430  GOTO 1340
  135. 1440  IF A$ = "a" THEN 1510
  136. 1450  IF A$ = "b" THEN 1660
  137. 1460  IF A$ = "c" THEN 1870
  138. 1470  IF A$ = "d" THEN 2000
  139. 1480  IF A$ = "q" THEN 1500
  140. 1490  GOTO 1330
  141. 1500  GOTO 2160
  142. 1510  CLS:SCREEN 0:LOCATE ,,0
  143. 1520  COLOR 15,0,3:LOCATE 5,15:PRINT"ORGANITEK"
  144. 1530  LOCATE 11,3:PRINT"Demonstrates how each strike of the"
  145. 1540  LOCATE 13,3:PRINT "keyboard can set off a rapid"
  146. 1550  LOCATE 15,3:PRINT "succession of interrelated tones."
  147. 1560  LOCATE 19,10:PRINT"capital Q to return"
  148. 1570  A$=INKEY$: IF A$="" THEN 1570
  149. 1580  IF A$ = "Q" THEN 650
  150. 1590  B$="\XzXxcXvXbXnmX,X./XaXsXdfXgXhjXkXlX;'X`XqwXeXrXtyXuXioXpX[X]1X2X34X5X6X78X9X0-X="
  151. 1600  NO=INSTR(1,B$,A$):NM = NO + 5:NP = NO -5
  152. 1610  IF NM >80 THEN NM = 80
  153. 1620  IF NP < 0 THEN NP = 0
  154. 1630  NO$=STR$(NO):NP$ = STR$(NP):NM$ = STR$(NM)
  155. 1640  PLAY "l25t255n" + NO$+"n"+ NP$+"N"+NM$
  156. 1650  GOTO 1570
  157. 1660  CLS:SCREEN 0:LOCATE ,,0
  158. 1670  COLOR 15,0,3:LOCATE 5,15:PRINT"ORGANISCOPE"
  159. 1680  LOCATE 11,3:PRINT"Demonstrates how two successive strikes "
  160. 1690  LOCATE 13,3:PRINT "of the keyboard can be interelated."
  161. 1700  LOCATE 15,3:PRINT "(In this case hitting all the tones in- between.)
  162. 1710  LOCATE 19,10:PRINT"capital Q to return"
  163. 1720  NM=20
  164. 1730  A$=INKEY$: IF A$="" THEN 1730
  165. 1740  IF A$ = "Q" THEN 650
  166. 1750  'B$="\zxcvbnm,./asdfghjkl;'`qwertyuiop[]1234567890-="
  167. 1760  B$="\XzXxcXvXbXnmX,X./XaXsXdfXgXhjXkXlX;'X`XqwXeXrXtyXuXioXpX[X]1X2X34X5X6X78X9X0-X="
  168. 1770  NO=INSTR(1,B$,A$)
  169. 1780  NO$=STR$(NO):NM$ = STR$(NM)
  170. 1790  IF NM=NO THEN 1730
  171. 1800  PLAY "l64t255n" + NO$+"n"+NM$
  172. 1810   PLAY "mll18t255n" + NO$
  173. 1820  IF NM < NO THEN 1850
  174. 1830  IF NM > NO THEN 1860
  175. 1840  GOTO 1730
  176. 1850  NM = NM + 1:GOTO 1780
  177. 1860  NM = NM - 1:GOTO 1780
  178. 1870  CLS:SCREEN 0:LOCATE ,,0
  179. 1880  COLOR 15,0,3:LOCATE 5,15:PRINT"BLUEZORG"
  180. 1890  LOCATE 11,3:PRINT"Demonstrates how the scale can be"
  181. 1900  LOCATE 13,3:PRINT "changed from an ordinary `c'"
  182. 1910  LOCATE 15,3:PRINT "scale to a `c'BLUES scale."
  183. 1920  LOCATE 19,10:PRINT"capital Q to return"
  184. 1930  A$=INKEY$: IF A$="" THEN 1930
  185. 1940  IF A$ = "Q" THEN 650
  186. 1950  B$="\XXzxcvbXXnm,XX./asdXXfghXXjkl;'XX`qwXXertyuXXiopXX[]123XX123XX45678XX90-XX="
  187. 1960  NO=INSTR(1,B$,A$):NM = NO + 5:NP = NO -1:NO$=STR$(NO):NP$ = STR$(NP):NM$ = STR$(NM)
  188. 1970  'PLAY "l25t255n" + NO$+"n"+ NP$+"N"+NM$
  189. 1980   PLAY "mnl18t255n" + NO$
  190. 1990  GOTO 1930
  191. 2000  SCREEN 0:LOCATE ,,0:CLS
  192. 2010  COLOR 15,0,3:LOCATE 5,15:PRINT"SPACEORG"
  193. 2020  LOCATE 11,3:PRINT"Demonstrates how the sound and play"
  194. 2030  LOCATE 13,3:PRINT "commands can be intertwined"
  195. 2040  LOCATE 15,3:PRINT "resulting in,among other things,"
  196. 2050  LOCATE 17,3:PRINT"a drone tone."
  197. 2060  LOCATE 19,10:PRINT"capital Q to return"
  198. 2070  A$=INKEY$: IF A$="" THEN 2070
  199. 2080  IF A$ = "Q" THEN 650
  200. 2090   B$=" \XzXxcXvXbXnmX,X./XaXsXdfXgXhjXkXlX;'X`XqwXeXrXtyXuXioXpX[X]1X2X34X5X6X78X9X0-X="
  201. 2100  NO=INSTR(1,B$,A$):NM = NO + 1:NP = NO -1:NO$=STR$(NO):NP$ = STR$(NP):NM$ = STR$(NM)
  202. 2110   PLAY "l64t255n" + NO$+"n"+ NP$+"N"+NM$
  203. 2120   PLAY "mnl30t255n" + NO$
  204. 2130  SOUND 37,0.5:SOUND 40,0.5
  205. 2140  A$=INKEY$: IF A$ ="" THEN 2120
  206. 2150  IF A$= "Q"THEN 650 ELSE GOTO 2090
  207. 2160  SCREEN 0:CLS:COLOR 15,4,3:LOCATE,,0
  208. 2170  A$="O1DDDO0A8B8O1L4C+D8L8C+O0L4BA2.O1DC+O0BABG8L8F+L4ED2."
  209. 2180  CLS:COLOR 0:PLAY "mbxa$;":LOCATE 3,3:PRINT"Do your programs have more bugs than a    `Roach Motel'?"
  210. 2190  PLAY "xa$;":LOCATE 7,1:PRINT"Is your disk drive possessed??"
  211. 2200  B$="mbO0DF+ABG+A2.DAABO1C+D2.C+DC+O0BBA2.BBABGL2f+."
  212. 2210  PLAY "xb$;":LOCATE 9,3:PRINT "Does your microprocessor have the       predictability of a four year old with      hemorrhoids???"
  213. 2220  C$="L4O1DC+O0BABG8L8F+L4ED2."
  214. 2230  PLAY "xc$;":LOCATE 14,15:COLOR 31,4,3:PRINT"!REPENT!":COLOR 15,4,3
  215. 2240  LOCATE 16,3:PRINT "and send all pirated programs to..."
  216. 2250  LOCATE 18,3:PRINT "Church of the Divine Programmer"
  217. 2260  LOCATE 19,3:PRINT "Antichrist, VA  01666"
  218. 2270  LOCATE 23,1:PRINT TAB(10);"hit any key to exit"
  219. 2280  A$=INKEY$:IF A$="" THEN 2280
  220. 2290  COLOR 7,0,0:WIDTH 80:CLS
  221.